home *** CD-ROM | disk | FTP | other *** search
/ Supercompiler 1997 / SUPERCOMPILER97.iso / Delphi 3.0 / DATA.Z / typinfo.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-01-29  |  35.3 KB  |  1,316 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {                                                       }
  6. {       Copyright (c) 1995,97 Borland International     }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit TypInfo;
  11.  
  12. interface
  13.  
  14. uses SysUtils;
  15.  
  16. type
  17.  
  18.   TTypeKind = (tkUnknown, tkInteger, tkChar, tkEnumeration, tkFloat,
  19.     tkString, tkSet, tkClass, tkMethod, tkWChar, tkLString, tkWString,
  20.     tkVariant, tkArray, tkRecord, tkInterface);
  21.   TTypeKinds = set of TTypeKind;
  22.  
  23.   TOrdType = (otSByte, otUByte, otSWord, otUWord, otSLong);
  24.  
  25.   TFloatType = (ftSingle, ftDouble, ftExtended, ftComp, ftCurr);
  26.  
  27.   TMethodKind = (mkProcedure, mkFunction, mkSafeProcedure, mkSafeFunction);
  28.   TParamFlags = set of (pfVar, pfConst, pfArray, pfAddress, pfReference, pfOut);
  29.   TIntfFlags = set of (ifHasGuid, ifDispInterface, ifDispatch);
  30.  
  31.   PPTypeInfo = ^PTypeInfo;
  32.   PTypeInfo = ^TTypeInfo;
  33.   TTypeInfo = record
  34.     Kind: TTypeKind;
  35.     Name: ShortString;
  36.    {TypeData: TTypeData}
  37.   end;
  38.  
  39.   PTypeData = ^TTypeData;
  40.   TTypeData = packed record
  41.     case TTypeKind of
  42.       tkUnknown, tkLString, tkWString, tkVariant: ();
  43.       tkInteger, tkChar, tkEnumeration, tkSet, tkWChar: (
  44.         OrdType: TOrdType;
  45.         case TTypeKind of
  46.           tkInteger, tkChar, tkEnumeration, tkWChar: (
  47.             MinValue: Longint;
  48.             MaxValue: Longint;
  49.             case TTypeKind of
  50.               tkInteger, tkChar, tkWChar: ();
  51.               tkEnumeration: (
  52.                 BaseType: PPTypeInfo;
  53.                 NameList: ShortString));
  54.           tkSet: (
  55.             CompType: PPTypeInfo));
  56.       tkFloat: (
  57.         FloatType: TFloatType);
  58.       tkString: (
  59.         MaxLength: Byte);
  60.       tkClass: (
  61.         ClassType: TClass;
  62.         ParentInfo: PPTypeInfo;
  63.         PropCount: SmallInt;
  64.         UnitName: ShortString
  65.        {PropData: TPropData});
  66.       tkMethod: (
  67.         MethodKind: TMethodKind;
  68.         ParamCount: Byte;
  69.         ParamList: array[0..1023] of Char
  70.        {ParamList: array[1..ParamCount] of
  71.           record
  72.             Flags: TParamFlags;
  73.             ParamName: ShortString;
  74.             TypeName: ShortString;
  75.           end;
  76.         ResultType: ShortString});
  77.       tkInterface: (
  78.         IntfParent : PPTypeInfo; { ancestor }
  79.         IntfFlags : TIntfFlags;
  80.         GUID : TGUID;
  81.         IntfUnit : ShortString;
  82.        {PropData: TPropData});
  83.   end;
  84.  
  85.   TPropData = packed record
  86.     PropCount: Word;
  87.     PropList: record end;
  88.    {PropList: array[1..PropCount] of TPropInfo}
  89.   end;
  90.  
  91.   PPropInfo = ^TPropInfo;
  92.   TPropInfo = packed record
  93.     PropType: PPTypeInfo;
  94.     GetProc: Pointer;
  95.     SetProc: Pointer;
  96.     StoredProc: Pointer;
  97.     Index: Integer;
  98.     Default: Longint;
  99.     NameIndex: SmallInt;
  100.     Name: ShortString;
  101.   end;
  102.  
  103.   TPropInfoProc = procedure(PropInfo: PPropInfo) of object;
  104.  
  105.   PPropList = ^TPropList;
  106.   TPropList = array[0..16379] of PPropInfo;
  107.  
  108. const
  109.   tkAny = [Low(TTypeKind)..High(TTypeKind)];
  110.   tkMethods = [tkMethod];
  111.   tkProperties = tkAny - tkMethods - [tkUnknown];
  112.  
  113. { Property access routines }
  114.  
  115. function GetTypeData(TypeInfo: PTypeInfo): PTypeData;
  116.  
  117. function GetEnumName(TypeInfo: PTypeInfo; Value: Integer): string;
  118. function GetEnumValue(TypeInfo: PTypeInfo; const Name: string): Integer;
  119.  
  120. function GetPropInfo(TypeInfo: PTypeInfo; const PropName: string): PPropInfo;
  121. procedure GetPropInfos(TypeInfo: PTypeInfo; PropList: PPropList);
  122. function GetPropList(TypeInfo: PTypeInfo; TypeKinds: TTypeKinds;
  123.   PropList: PPropList): Integer;
  124.  
  125. function IsStoredProp(Instance: TObject; PropInfo: PPropInfo): Boolean;
  126.  
  127. function GetOrdProp(Instance: TObject; PropInfo: PPropInfo): Longint;
  128. procedure SetOrdProp(Instance: TObject; PropInfo: PPropInfo;
  129.   Value: Longint);
  130.  
  131. function GetStrProp(Instance: TObject; PropInfo: PPropInfo): string;
  132. procedure SetStrProp(Instance: TObject; PropInfo: PPropInfo;
  133.   const Value: string);
  134.  
  135. function GetFloatProp(Instance: TObject; PropInfo: PPropInfo): Extended;
  136. procedure SetFloatProp(Instance: TObject; PropInfo: PPropInfo;
  137.   Value: Extended);
  138.  
  139. function GetVariantProp(Instance: TObject; PropInfo: PPropInfo): Variant;
  140. procedure SetVariantProp(Instance: TObject; PropInfo: PPropInfo;
  141.   const Value: Variant);
  142.  
  143. function GetMethodProp(Instance: TObject; PropInfo: PPropInfo): TMethod;
  144. procedure SetMethodProp(Instance: TObject; PropInfo: PPropInfo;
  145.   const Value: TMethod);
  146.  
  147. implementation
  148.  
  149. function GetTypeData(TypeInfo: PTypeInfo): PTypeData; assembler;
  150. asm
  151.         { ->    EAX Pointer to type info }
  152.         { <-    EAX Pointer to type data }
  153.         {       it's really just to skip the kind and the name  }
  154.         XOR     EDX,EDX
  155.         MOV     DL,[EAX].TTypeInfo.Name.Byte[0]
  156.         LEA     EAX,[EAX].TTypeInfo.Name[EDX+1]
  157. end;
  158.  
  159. function GetEnumName(TypeInfo: PTypeInfo; Value: Integer): string;
  160. var
  161.   P: ^ShortString;
  162. begin
  163.   P := @GetTypeData(GetTypeData(TypeInfo)^.BaseType^)^.NameList;
  164.   while Value <> 0 do
  165.   begin
  166.     Inc(Integer(P), Length(P^) + 1);
  167.     Dec(Value);
  168.   end;
  169.   Result := P^;
  170. end;
  171.  
  172. function GetEnumValue(TypeInfo: PTypeInfo; const Name: string): Integer;
  173.   assembler;
  174. asm
  175.         { ->    EAX Pointer to type info        }
  176.         {       EDX Pointer to string           }
  177.         { <-    EAX Value                       }
  178.  
  179.         PUSH    EBX
  180.         PUSH    ESI
  181.         PUSH    EDI
  182.  
  183.     TEST    EDX,EDX
  184.     JE    @notFound
  185.  
  186.         {       point ESI to first name of the base type }
  187.         XOR     ECX,ECX
  188.         MOV     CL,[EAX].TTypeInfo.Name.Byte[0]
  189.         MOV     EAX,[EAX].TTypeInfo.Name[ECX+1].TTypeData.BaseType
  190.         MOV     EAX,[EAX]
  191.         MOV     CL,[EAX].TTypeInfo.Name.Byte[0]
  192.         LEA     ESI,[EAX].TTypeInfo.Name[ECX+1].TTypeData.NameList
  193.  
  194.         {       make EDI the high bound of the enum type }
  195.         MOV     EDI,[EAX].TTypeInfo.Name[ECX+1].TTypeData.MaxValue
  196.  
  197.         {       EAX is our running index }
  198.         XOR     EAX,EAX
  199.  
  200.         {       make ECX the length of the current string }
  201.  
  202. @outerLoop:
  203.         MOV     CL,[ESI]
  204.     CMP    ECX,[EDX-4]
  205.         JNE     @lengthMisMatch
  206.  
  207.         {       we know for sure the names won't be zero length }
  208. @cmpLoop:
  209.         MOV     BL,[EDX+ECX-1]
  210.         XOR     BL,[ESI+ECX]
  211.         TEST    BL,0DFH
  212.         JNE     @misMatch
  213.         DEC     ECX
  214.         JNE     @cmpLoop
  215.  
  216.         {       as we didn't have a mismatch, we must have found the name }
  217.         JMP     @exit
  218.  
  219. @misMatch:
  220.         MOV     CL,[ESI]
  221. @lengthMisMatch:
  222.         INC     EAX
  223.         LEA     ESI,[ESI+ECX+1]
  224.         CMP     EAX,EDI
  225.         JLE     @outerLoop
  226.  
  227.         {       we haven't found the thing - return -1  }
  228. @notFound:
  229.         OR      EAX,-1
  230.  
  231. @exit:
  232.         POP     EDI
  233.         POP     ESI
  234.     POP    EBX
  235. end;
  236.  
  237. function GetPropInfo(TypeInfo: PTypeInfo; const PropName: string): PPropInfo;
  238.   assembler;
  239. asm
  240.         { ->    EAX Pointer to type info        }
  241.         {       EDX Pointer to prop name        }
  242.         { <-    EAX Pointer to prop info        }
  243.  
  244.         PUSH    EBX
  245.         PUSH    ESI
  246.         PUSH    EDI
  247.  
  248.         MOV     ECX,EDX
  249.         OR      EDX,EDX
  250.         JE      @outerLoop
  251.         MOV     CL,[EDX-4]
  252.         MOV     CH,[EDX]
  253.         AND     ECX,0DFFFH
  254.  
  255. @outerLoop:
  256.         XOR     EBX,EBX
  257.         MOV     BL,[EAX].TTypeInfo.Name.Byte[0]
  258.         LEA     ESI,[EAX].TTypeInfo.Name[EBX+1]
  259.         MOV     BL,[ESI].TTypeData.UnitName.Byte[0]
  260.         MOVZX   EDI,[ESI].TTypeData.UnitName[EBX+1].TPropData.PropCount
  261.         TEST    EDI,EDI
  262.         JE      @parent
  263.         LEA     EAX,[ESI].TTypeData.UnitName[EBX+1].TPropData.PropList
  264.  
  265. @innerLoop:
  266.         MOV     BX,[EAX].TPropInfo.Name.Word[0]
  267.         AND     BH,0DFH
  268.         CMP     EBX,ECX
  269.         JE      @matchStart
  270.  
  271. @nextProperty:
  272.         MOV     BH,0
  273.         DEC     EDI
  274.         LEA     EAX,[EAX].TPropInfo.Name[EBX+1]
  275.         JNE     @innerLoop
  276.  
  277. @parent:
  278.         MOV     EAX,[ESI].TTypeData.ParentInfo
  279.         TEST    EAX,EAX
  280.         JE      @exit
  281.         MOV     EAX,[EAX]
  282.         JMP     @outerLoop
  283.  
  284. @misMatch:
  285.         MOV     CH,[EDX]
  286.         AND     CH,0DFH
  287.         MOV     BL,[EAX].TPropInfo.Name.Byte[0]
  288.         JMP     @nextProperty
  289.  
  290. @matchStart:
  291.         MOV     BH,0
  292.  
  293. @matchLoop:
  294.         MOV     CH,[EDX+EBX-1]
  295.         XOR     CH,[EAX].TPropInfo.Name.Byte[EBX]
  296.         TEST    CH,0DFH
  297.         JNE     @misMatch
  298.         DEC     EBX
  299.         JNE     @matchLoop
  300.  
  301. @exit:
  302.         POP     EDI
  303.         POP     ESI
  304.         POP     EBX
  305. end;
  306.  
  307. procedure GetPropInfos(TypeInfo: PTypeInfo; PropList: PPropList); assembler;
  308. asm
  309.         { ->    EAX Pointer to type info        }
  310.         {       EDX Pointer to prop list        }
  311.         { <-    nothing                         }
  312.  
  313.         PUSH    EBX
  314.         PUSH    ESI
  315.         PUSH    EDI
  316.  
  317.         XOR     ECX,ECX
  318.         MOV     ESI,EAX
  319.         MOV     CL,[EAX].TTypeInfo.Name.Byte[0]
  320.         MOV     EDI,EDX
  321.         XOR     EAX,EAX
  322.         MOVZX   ECX,[ESI].TTypeInfo.Name[ECX+1].TTypeData.PropCount
  323.         REP     STOSD
  324.  
  325. @outerLoop:
  326.         MOV     CL,[ESI].TTypeInfo.Name.Byte[0]
  327.         LEA     ESI,[ESI].TTypeInfo.Name[ECX+1]
  328.         MOV     CL,[ESI].TTypeData.UnitName.Byte[0]
  329.         MOVZX   EAX,[ESI].TTypeData.UnitName[ECX+1].TPropData.PropCount
  330.         TEST    EAX,EAX
  331.         JE      @parent
  332.         LEA     EDI,[ESI].TTypeData.UnitName[ECX+1].TPropData.PropList
  333.  
  334. @innerLoop:
  335.  
  336.         MOVZX   EBX,[EDI].TPropInfo.NameIndex
  337.         MOV     CL,[EDI].TPropInfo.Name.Byte[0]
  338.         CMP     dword ptr [EDX+EBX*4],0
  339.         JNE     @alreadySet
  340.         MOV     [EDX+EBX*4],EDI
  341.  
  342. @alreadySet:
  343.         LEA     EDI,[EDI].TPropInfo.Name[ECX+1]
  344.         DEC     EAX
  345.         JNE     @innerLoop
  346.  
  347. @parent:
  348.         MOV     ESI,[ESI].TTypeData.ParentInfo
  349.         XOR     ECX,ECX
  350.         TEST    ESI,ESI
  351.         JE      @exit
  352.         MOV     ESI,[ESI]
  353.         JMP     @outerLoop
  354. @exit:
  355.         POP     EDI
  356.         POP     ESI
  357.         POP     EBX
  358.  
  359. end;
  360.  
  361. procedure SortPropList(PropList: PPropList; PropCount: Integer); assembler;
  362. asm
  363.         { ->    EAX Pointer to prop list        }
  364.         {       EDX Property count              }
  365.         { <-    nothing                         }
  366.  
  367.         PUSH    EBX
  368.         PUSH    ESI
  369.         PUSH    EDI
  370.         MOV     ECX,EAX
  371.         XOR     EAX,EAX
  372.         DEC     EDX
  373.         CALL    @@qsort
  374.         POP     EDI
  375.         POP     ESI
  376.         POP     EBX
  377.         JMP     @@exit
  378.  
  379. @@qsort:
  380.         PUSH    EAX
  381.         PUSH    EDX
  382.         LEA     EDI,[EAX+EDX]           { pivot := (left + right) div 2 }
  383.         SHR     EDI,1
  384.         MOV     EDI,[ECX+EDI*4]
  385.         ADD     EDI,OFFSET TPropInfo.Name
  386. @@repeat:                               { repeat                        }
  387. @@while1:
  388.         CALL    @@compare               { while a[i] < a[pivot] do inc(i);}
  389.         JAE     @@endWhile1
  390.         INC     EAX
  391.         JMP     @@while1
  392. @@endWhile1:
  393.         XCHG    EAX,EDX
  394. @@while2:
  395.         CALL    @@compare               { while a[j] > a[pivot] do dec(j);}
  396.         JBE     @@endWhile2
  397.         DEC     EAX
  398.         JMP     @@while2
  399. @@endWhile2:
  400.         XCHG    EAX,EDX
  401.         CMP     EAX,EDX                 { if i <= j then begin          }
  402.         JG      @@endRepeat
  403.         MOV     EBX,[ECX+EAX*4]         { x := a[i];                    }
  404.         MOV     ESI,[ECX+EDX*4]         { y := a[j];                    }
  405.         MOV     [ECX+EDX*4],EBX         { a[j] := x;                    }
  406.         MOV     [ECX+EAX*4],ESI         { a[i] := y;                    }
  407.         INC     EAX                     { inc(i);                       }
  408.         DEC     EDX                     { dec(j);                       }
  409.                                         { end;                          }
  410.         CMP     EAX,EDX                 { until i > j;                  }
  411.         JLE     @@repeat
  412.  
  413. @@endRepeat:
  414.         POP     ESI
  415.         POP     EBX
  416.  
  417.         CMP     EAX,ESI
  418.         JL      @@rightNonEmpty         { if i >= right then begin      }
  419.         CMP     EDX,EBX
  420.         JG      @@leftNonEmpty1         { if j <= left then exit        }
  421.         RET
  422.  
  423. @@leftNonEmpty1:
  424.         MOV     EAX,EBX
  425.         JMP     @@qsort                 { qsort(left, j)                }
  426.  
  427. @@rightNonEmpty:
  428.         CMP     EAX,EBX
  429.         JG      @@leftNonEmpty2
  430.         MOV     EDX,ESI                 { qsort(i, right)               }
  431.         JMP     @@qsort
  432. @@leftNonEmpty2:
  433.         PUSH    EAX
  434.         PUSH    ESI
  435.         MOV     EAX,EBX
  436.         CALL    @@qsort                 { qsort(left, j)                }
  437.         POP     EDX
  438.         POP     EAX
  439.         JMP     @@qsort                 { qsort(i, right)               }
  440.  
  441. @@compare:
  442.         PUSH    EAX
  443.         PUSH    EDI
  444.         MOV     ESI,[ECX+EAX*4]
  445.         ADD     ESI,OFFSET TPropInfo.Name
  446.         PUSH    ESI
  447.         XOR     EBX,EBX
  448.         MOV     BL,[ESI]
  449.         INC     ESI
  450.         CMP     BL,[EDI]
  451.         JBE     @@firstLenSmaller
  452.         MOV     BL,[EDI]
  453. @@firstLenSmaller:
  454.         INC     EDI
  455.         TEST    BL,BL
  456.         JE      @@endLoop
  457. @@loop:
  458.         MOV     AL,[ESI]
  459.         MOV     AH,[EDI]
  460.         AND     EAX,$DFDF
  461.         CMP     AL,AH
  462.         JNE     @@difference
  463.         INC     ESI
  464.         INC     EDI
  465.         DEC     EBX
  466.         JNZ     @@loop
  467. @@endLoop:
  468.         POP     ESI
  469.         POP     EDI
  470.         MOV     AL,[ESI]
  471.         MOV     AH,[EDI]
  472.         CMP     AL,AH
  473.         POP     EAX
  474.         RET
  475. @@difference:
  476.         POP     ESI
  477.         POP     EDI
  478.         POP     EAX
  479.         RET
  480. @@exit:
  481. end;
  482.  
  483. { TypeInfo is the type info of a class. Return all properties matching
  484.   TypeKinds in this class or its ancestors in PropList and return the count }
  485.  
  486. function GetPropList(TypeInfo: PTypeInfo; TypeKinds: TTypeKinds;
  487.   PropList: PPropList): Integer;
  488. var
  489.   I, Count: Integer;
  490.   PropInfo: PPropInfo;
  491.   TempList: PPropList;
  492. begin
  493.   Result := 0;
  494.   Count := GetTypeData(TypeInfo)^.PropCount;
  495.   if Count > 0 then
  496.   begin
  497.     GetMem(TempList, Count * SizeOf(Pointer));
  498.     try
  499.       GetPropInfos(TypeInfo, TempList);
  500.       for I := 0 to Count - 1 do
  501.       begin
  502.         PropInfo := TempList^[I];
  503.         if PropInfo^.PropType^.Kind in TypeKinds then
  504.         begin
  505.           if PropList <> nil then PropList^[Result] := PropInfo;
  506.           Inc(Result);
  507.         end;
  508.         if (PropList <> nil) and (Result > 1) then
  509.           SortPropList(PropList, Result);
  510.       end;
  511.     finally
  512.       FreeMem(TempList, Count * SizeOf(Pointer));
  513.     end;
  514.   end;
  515. end;
  516.  
  517. function IsStoredProp(Instance: TObject; PropInfo: PPropInfo): Boolean;
  518.   assembler;
  519. asm
  520.         { ->    EAX Pointer to Instance         }
  521.         {       EDX Pointer to prop info        }
  522.         { <-    AL  Function result             }
  523.  
  524.         MOV     ECX,[EDX].TPropInfo.StoredProc
  525.         TEST    ECX,0FFFFFF00H
  526.         JE      @@returnCL
  527.         CMP     [EDX].TPropInfo.StoredProc.Byte[3],0FEH
  528.         MOV     EDX,[EDX].TPropInfo.Index
  529.         JB      @@isStaticMethod
  530.         JA      @@isField
  531.  
  532.         {       the StoredProc is a virtual method }
  533.         MOVSX   ECX,CX                  { sign extend slot offs }
  534.         ADD     ECX,[EAX]               { vmt   + slotoffs      }
  535.         CALL    dword ptr [ECX]         { call vmt[slot]        }
  536.         JMP     @@exit
  537.  
  538. @@isStaticMethod:
  539.         CALL    ECX
  540.         JMP     @@exit
  541.  
  542. @@isField:
  543.         AND     ECX,$00FFFFFF
  544.         MOV     CL,[EAX+ECX]
  545.  
  546. @@returnCL:
  547.         MOV     AL,CL
  548.  
  549. @@exit:
  550. end;
  551.  
  552. function GetOrdProp(Instance: TObject; PropInfo: PPropInfo): Longint;
  553.   assembler;
  554. asm
  555.         { ->    EAX Pointer to instance         }
  556.         {       EDX Pointer to property info    }
  557.         { <-    EAX Longint result              }
  558.  
  559.         PUSH    EBX
  560.         PUSH    EDI
  561.         MOV     EDI,[EDX].TPropInfo.PropType
  562.         MOV     EDI,[EDI]
  563.         MOV     BL,otSLong
  564.         CMP     [EDI].TTypeInfo.Kind,tkClass
  565.         JE      @@isClass
  566.         XOR     ECX,ECX
  567.         MOV     CL,[EDI].TTypeInfo.Name.Byte[0]
  568.         MOV     BL,[EDI].TTypeInfo.Name[ECX+1].TTypeData.OrdType
  569. @@isClass:
  570.         MOV     ECX,[EDX].TPropInfo.GetProc
  571.         CMP     [EDX].TPropInfo.GetProc.Byte[3],$FE
  572.         MOV     EDX,[EDX].TPropInfo.Index
  573.         JB      @@isStaticMethod
  574.         JA      @@isField
  575.  
  576.         {       the GetProc is a virtual method }
  577.         MOVSX   ECX,CX                  { sign extend slot offs }
  578.         ADD     ECX,[EAX]               { vmt   + slotoffs      }
  579.         CALL    dword ptr [ECX]         { call vmt[slot]        }
  580.         JMP     @@final
  581.  
  582. @@isStaticMethod:
  583.         CALL    ECX
  584.         JMP     @@final
  585.  
  586. @@isField:
  587.         AND     ECX,$00FFFFFF
  588.         ADD     ECX,EAX
  589.         MOV     AL,[ECX]
  590.         CMP     BL,otSWord
  591.         JB      @@final
  592.         MOV     AX,[ECX]
  593.         CMP     BL,otSLong
  594.         JB      @@final
  595.         MOV     EAX,[ECX]
  596. @@final:
  597.         CMP     BL,otSLong
  598.         JAE     @@exit
  599.         CMP     BL,otSWord
  600.         JAE     @@word
  601.         CMP     BL,otSByte
  602.         MOVSX   EAX,AL
  603.         JE      @@exit
  604.         AND     EAX,$FF
  605.         JMP     @@exit
  606. @@word:
  607.         MOVSX   EAX,AX
  608.         JE      @@exit
  609.         AND     EAX,$FFFF
  610. @@exit:
  611.         POP     EDI
  612.         POP     EBX
  613. end;
  614.  
  615. procedure SetOrdProp(Instance: TObject; PropInfo: PPropInfo;
  616.   Value: Longint); assembler;
  617. asm
  618.         { ->    EAX Pointer to instance         }
  619.         {       EDX Pointer to property info    }
  620.         {       ECX Value                       }
  621.  
  622.         PUSH    EBX
  623.         PUSH    ESI
  624.         PUSH    EDI
  625.         MOV     EDI,EDX
  626.  
  627.         MOV     ESI,[EDI].TPropInfo.PropType
  628.         MOV     ESI,[ESI]
  629.         MOV     BL,otSLong
  630.         CMP     [ESI].TTypeInfo.Kind,tkClass
  631.         JE      @@isClass
  632.         XOR     EBX,EBX
  633.         MOV     BL,[ESI].TTypeInfo.Name.Byte[0]
  634.         MOV     BL,[ESI].TTypeInfo.Name[EBX+1].TTypeData.OrdType
  635. @@isClass:
  636.         MOV     EDX,[EDI].TPropInfo.Index       { pass Index in DX      }
  637.         CMP     EDX,$80000000
  638.         JNE     @@hasIndex
  639.         MOV     EDX,ECX                         { pass value in EDX     }
  640. @@hasIndex:
  641.         MOV     ESI,[EDI].TPropInfo.SetProc
  642.         CMP     [EDI].TPropInfo.SetProc.Byte[3],$FE
  643.         JA      @@isField
  644.         JB      @@isStaticMethod
  645.  
  646.         {       SetProc turned out to be a virtual method. call it      }
  647.         MOVSX   ESI,SI                          { sign extend slot offset }
  648.         ADD     ESI,[EAX]                       { vmt   + slot offset   }
  649.         CALL    dword ptr [ESI]
  650.         JMP     @@exit
  651.  
  652. @@isStaticMethod:
  653.         CALL    ESI
  654.         JMP     @@exit
  655.  
  656. @@isField:
  657.         AND     ESI,$00FFFFFF
  658.         ADD     EAX,ESI
  659.         MOV     [EAX],CL
  660.         CMP     BL,otSWord
  661.         JB      @@exit
  662.         MOV     [EAX],CX
  663.         CMP     BL,otSLong
  664.         JB      @@exit
  665.         MOV     [EAX],ECX
  666. @@exit:
  667.         POP     EDI
  668.         POP     ESI
  669.         POP     EBX
  670. end;
  671.  
  672. procedure GetShortStrProp(Instance: TObject; PropInfo: PPropInfo;
  673.   var Value: ShortString); assembler;
  674. asm
  675.         { ->    EAX Pointer to instance         }
  676.         {       EDX Pointer to property info    }
  677.         {       ECX Pointer to result string    }
  678.  
  679.         PUSH    ESI
  680.         PUSH    EDI
  681.         MOV     EDI,EDX
  682.  
  683.         MOV     EDX,[EDI].TPropInfo.Index       { pass index in EDX }
  684.         CMP     EDX,$80000000
  685.         JNE     @@hasIndex
  686.         MOV     EDX,ECX                         { pass value in EDX }
  687. @@hasIndex:
  688.         MOV     ESI,[EDI].TPropInfo.GetProc
  689.         CMP     [EDI].TPropInfo.GetProc.Byte[3],$FE
  690.         JA      @@isField
  691.         JB      @@isStaticMethod
  692.  
  693.         {       GetProc turned out to be a virtual method       }
  694.         MOVSX   ESI,SI                          { sign extend slot offset}
  695.         ADD     ESI,[EAX]                       { vmt + slot offset     }
  696.         CALL    dword ptr [ESI]
  697.         JMP     @@exit
  698.  
  699. @@isStaticMethod:
  700.         CALL    ESI
  701.         JMP     @@exit
  702.  
  703. @@isField:
  704.         AND     ESI,$00FFFFFF
  705.         ADD     ESI,EAX
  706.         MOV     EDI,ECX
  707.         XOR     ECX,ECX
  708.         MOV     CL,[ESI]
  709.         INC     ECX
  710.         REP     MOVSB
  711.  
  712. @@exit:
  713.         POP     EDI
  714.         POP     ESI
  715. end;
  716.  
  717. procedure SetShortStrProp(Instance: TObject; PropInfo: PPropInfo;
  718.   const Value: ShortString); assembler;
  719. asm
  720.         { ->    EAX Pointer to instance         }
  721.         {       EDX Pointer to property info    }
  722.         {       ECX Pointer to string value     }
  723.  
  724.         PUSH    ESI
  725.         PUSH    EDI
  726.         MOV     ESI,EDX
  727.  
  728.         MOV     EDX,[ESI].TPropInfo.Index       { pass index in EDX }
  729.         CMP     EDX,$80000000
  730.         JNE     @@hasIndex
  731.         MOV     EDX,ECX                         { pass value in EDX }
  732. @@hasIndex:
  733.         MOV     EDI,[ESI].TPropInfo.SetProc
  734.         CMP     [ESI].TPropInfo.SetProc.Byte[3],$FE
  735.         JA      @@isField
  736.         JB      @@isStaticMethod
  737.  
  738.         {       SetProc is a virtual method }
  739.         MOVSX   EDI,DI
  740.         ADD     EDI,[EAX]
  741.         CALL    dword ptr [EDI]
  742.         JMP     @@exit
  743.  
  744. @@isStaticMethod:
  745.         CALL    EDI
  746.         JMP     @@exit
  747.  
  748. @@isField:
  749.         AND     EDI,$00FFFFFF
  750.         ADD     EDI,EAX
  751.         MOV     EAX,[ESI].TPropInfo.PropType
  752.         MOV     EAX,[EAX]
  753.         MOV     ESI,ECX
  754.         XOR     ECX,ECX
  755.         MOV     CL,[EAX].TTypeInfo.Name.Byte[0]
  756.         MOV     CL,[EAX].TTypeInfo.Name[ECX+1].TTypeData.MaxLength
  757.  
  758.         LODSB
  759.         CMP     AL,CL
  760.         JB      @@noTruncate
  761.         MOV     AL,CL
  762. @@noTruncate:
  763.         STOSB
  764.         MOV     CL,AL
  765.         REP     MOVSB
  766. @@exit:
  767.         POP     EDI
  768.         POP     ESI
  769. end;
  770.  
  771. procedure GetShortStrPropAsLongStr(Instance: TObject; PropInfo: PPropInfo;
  772.   var Value: string);
  773. var
  774.   Temp: ShortString;
  775. begin
  776.   GetShortStrProp(Instance, PropInfo, Temp);
  777.   Value := Temp;
  778. end;
  779.  
  780. procedure SetShortStrPropAsLongStr(Instance: TObject; PropInfo: PPropInfo;
  781.   const Value: string); assembler;
  782. var
  783.   Temp: ShortString;
  784. begin
  785.   Temp := Value;
  786.   SetShortStrProp(Instance, PropInfo, Temp);
  787. end;
  788.  
  789. procedure AssignLongStr(var Dest: string; const Source: string);
  790. begin
  791.   Dest := Source;
  792. end;
  793.  
  794. procedure GetLongStrProp(Instance: TObject; PropInfo: PPropInfo;
  795.   var Value: string); assembler;
  796. asm
  797.         { ->    EAX Pointer to instance         }
  798.         {       EDX Pointer to property info    }
  799.         {       ECX Pointer to result string    }
  800.  
  801.         PUSH    ESI
  802.         PUSH    EDI
  803.         MOV     EDI,EDX
  804.  
  805.         MOV     EDX,[EDI].TPropInfo.Index       { pass index in EDX }
  806.         CMP     EDX,$80000000
  807.         JNE     @@hasIndex
  808.         MOV     EDX,ECX                         { pass value in EDX }
  809. @@hasIndex:
  810.         MOV     ESI,[EDI].TPropInfo.GetProc
  811.         CMP     [EDI].TPropInfo.GetProc.Byte[3],$FE
  812.         JA      @@isField
  813.         JB      @@isStaticMethod
  814.  
  815. @@isVirtualMethod:
  816.         MOVSX   ESI,SI                          { sign extend slot offset }
  817.         ADD     ESI,[EAX]                       { vmt + slot offset }
  818.         CALL    DWORD PTR [ESI]
  819.         JMP     @@exit
  820.  
  821. @@isStaticMethod:
  822.         CALL    ESI
  823.         JMP     @@exit
  824.  
  825. @@isField:
  826.     AND    ESI,$00FFFFFF
  827.     MOV    EDX,[EAX+ESI]
  828.     MOV    EAX,ECX
  829.     CALL    AssignLongStr
  830.  
  831. @@exit:
  832.         POP     EDI
  833.         POP     ESI
  834. end;
  835.  
  836. procedure SetLongStrProp(Instance: TObject; PropInfo: PPropInfo;
  837.   const Value: string); assembler;
  838. asm
  839.         { ->    EAX Pointer to instance         }
  840.         {       EDX Pointer to property info    }
  841.         {       ECX Pointer to string value     }
  842.  
  843.         PUSH    ESI
  844.         PUSH    EDI
  845.         MOV     ESI,EDX
  846.  
  847.         MOV     EDX,[ESI].TPropInfo.Index       { pass index in EDX }
  848.         CMP     EDX,$80000000
  849.         JNE     @@hasIndex
  850.         MOV     EDX,ECX                         { pass value in EDX }
  851. @@hasIndex:
  852.         MOV     EDI,[ESI].TPropInfo.SetProc
  853.         CMP     [ESI].TPropInfo.SetProc.Byte[3],$FE
  854.         JA      @@isField
  855.         JB      @@isStaticMethod
  856.  
  857. @@isVirtualMethod:
  858.         MOVSX   EDI,DI
  859.         ADD     EDI,[EAX]
  860.         CALL    DWORD PTR [EDI]
  861.         JMP     @@exit
  862.  
  863. @@isStaticMethod:
  864.         CALL    EDI
  865.         JMP     @@exit
  866.  
  867. @@isField:
  868.     AND    EDI,$00FFFFFF
  869.     ADD    EAX,EDI
  870.     MOV    EDX,ECX
  871.     CALL    AssignLongStr
  872.  
  873. @@exit:
  874.         POP     EDI
  875.         POP     ESI
  876. end;
  877.  
  878. procedure AssignWideStr(var Dest: WideString; const Source: WideString);
  879. begin
  880.   Dest := Source;
  881. end;
  882.  
  883. procedure GetWideStrProp(Instance: TObject; PropInfo: PPropInfo;
  884.   var Value: WideString); assembler;
  885. asm
  886.         { ->    EAX Pointer to instance         }
  887.         {       EDX Pointer to property info    }
  888.         {       ECX Pointer to result string    }
  889.  
  890.         PUSH    ESI
  891.         PUSH    EDI
  892.         MOV     EDI,EDX
  893.  
  894.         MOV     EDX,[EDI].TPropInfo.Index       { pass index in EDX }
  895.         CMP     EDX,$80000000
  896.         JNE     @@hasIndex
  897.         MOV     EDX,ECX                         { pass value in EDX }
  898. @@hasIndex:
  899.         MOV     ESI,[EDI].TPropInfo.GetProc
  900.         CMP     [EDI].TPropInfo.GetProc.Byte[3],$FE
  901.         JA      @@isField
  902.         JB      @@isStaticMethod
  903.  
  904. @@isVirtualMethod:
  905.         MOVSX   ESI,SI                          { sign extend slot offset }
  906.         ADD     ESI,[EAX]                       { vmt + slot offset }
  907.         CALL    DWORD PTR [ESI]
  908.         JMP     @@exit
  909.  
  910. @@isStaticMethod:
  911.         CALL    ESI
  912.         JMP     @@exit
  913.  
  914. @@isField:
  915.     AND    ESI,$00FFFFFF
  916.     MOV    EDX,[EAX+ESI]
  917.     MOV    EAX,ECX
  918.     CALL    AssignWideStr
  919.  
  920. @@exit:
  921.         POP     EDI
  922.         POP     ESI
  923. end;
  924.  
  925. procedure SetWideStrProp(Instance: TObject; PropInfo: PPropInfo;
  926.   const Value: WideString); assembler;
  927. asm
  928.         { ->    EAX Pointer to instance         }
  929.         {       EDX Pointer to property info    }
  930.         {       ECX Pointer to string value     }
  931.  
  932.         PUSH    ESI
  933.         PUSH    EDI
  934.         MOV     ESI,EDX
  935.  
  936.         MOV     EDX,[ESI].TPropInfo.Index       { pass index in EDX }
  937.         CMP     EDX,$80000000
  938.         JNE     @@hasIndex
  939.         MOV     EDX,ECX                         { pass value in EDX }
  940. @@hasIndex:
  941.         MOV     EDI,[ESI].TPropInfo.SetProc
  942.         CMP     [ESI].TPropInfo.SetProc.Byte[3],$FE
  943.         JA      @@isField
  944.         JB      @@isStaticMethod
  945.  
  946. @@isVirtualMethod:
  947.         MOVSX   EDI,DI
  948.         ADD     EDI,[EAX]
  949.         CALL    DWORD PTR [EDI]
  950.         JMP     @@exit
  951.  
  952. @@isStaticMethod:
  953.         CALL    EDI
  954.         JMP     @@exit
  955.  
  956. @@isField:
  957.     AND    EDI,$00FFFFFF
  958.     ADD    EAX,EDI
  959.     MOV    EDX,ECX
  960.     CALL    AssignWideStr
  961.  
  962. @@exit:
  963.         POP     EDI
  964.         POP     ESI
  965. end;
  966.  
  967. procedure GetWideStrPropAsLongStr(Instance: TObject; PropInfo: PPropInfo;
  968.   var Value: string);
  969. var
  970.   Temp: WideString;
  971. begin
  972.   GetWideStrProp(Instance, PropInfo, Temp);
  973.   Value := Temp;
  974. end;
  975.  
  976. procedure SetWideStrPropAsLongStr(Instance: TObject; PropInfo: PPropInfo;
  977.   const Value: string); assembler;
  978. var
  979.   Temp: WideString;
  980. begin
  981.   Temp := Value;
  982.   SetWideStrProp(Instance, PropInfo, Temp);
  983. end;
  984.  
  985. function GetStrProp(Instance: TObject; PropInfo: PPropInfo): string;
  986. begin
  987.   case PropInfo^.PropType^.Kind of
  988.     tkString: GetShortStrPropAsLongStr(Instance, PropInfo, Result);
  989.     tkLString: GetLongStrProp(Instance, PropInfo, Result);
  990.     tkWString: GetWideStrPropAsLongStr(Instance, PropInfo, Result);
  991.   else
  992.     Result := '';
  993.   end;
  994. end;
  995.  
  996. procedure SetStrProp(Instance: TObject; PropInfo: PPropInfo;
  997.   const Value: string);
  998. begin
  999.   case PropInfo^.PropType^.Kind of
  1000.     tkString: SetShortStrPropAsLongStr(Instance, PropInfo, Value);
  1001.     tkLString: SetLongStrProp(Instance, PropInfo, Value);
  1002.     tkWString: SetWideStrPropAsLongStr(Instance, PropInfo, Value);
  1003.   end;
  1004. end;
  1005.  
  1006. const
  1007.   C10000: Single = 10000;
  1008.  
  1009. function GetFloatProp(Instance: TObject; PropInfo: PPropInfo): Extended;
  1010.   assembler;
  1011. asm
  1012.         { ->    EAX Pointer to instance         }
  1013.         {       EDX Pointer to property info    }
  1014.         { <-    FST(0) Extended result          }
  1015.  
  1016.         MOV     ECX,[EDX].TPropInfo.GetProc
  1017.         CMP     [EDX].TPropInfo.GetProc.Byte[3],$FE
  1018.         JA      @@isField
  1019.         JE      @@isVirtualMethod
  1020.  
  1021.         MOV     EDX,[EDX].TPropInfo.Index       { pass Index in DX      }
  1022.         CALL    ECX
  1023.         JMP     @@exit
  1024.  
  1025. @@isVirtualMethod:
  1026.         MOVSX   ECX,CX
  1027.         ADD     ECX,[EAX]
  1028.         MOV     EDX,[EDX].TPropInfo.Index       { pass Index in DX      }
  1029.         CALL    dword ptr [ECX]
  1030.         JMP     @@exit
  1031.  
  1032. @@jmpTab:
  1033.         DD      @@single,@@double,@@extended,@@comp,@@curr
  1034.  
  1035. @@single:
  1036.         FLD     [EAX].Single
  1037.         RET
  1038.  
  1039. @@double:
  1040.         FLD     [EAX].Double
  1041.         RET
  1042.  
  1043. @@extended:
  1044.         FLD     [EAX].Extended
  1045.         RET
  1046.  
  1047. @@comp:
  1048.         FILD    [EAX].Comp
  1049.         RET
  1050.  
  1051. @@curr:
  1052.         FILD    [EAX].Currency
  1053.         FDIV    C10000
  1054.         RET
  1055.  
  1056. @@isField:
  1057.         AND     ECX,$00FFFFFF
  1058.         ADD     EAX,ECX
  1059.         MOV     ECX,[EDX].TPropInfo.PropType
  1060.         MOV     ECX,[ECX]
  1061.         XOR     EDX,EDX
  1062.         MOV     DL,[ECX].TTypeInfo.Name.Byte[0]
  1063.         MOV     DL,[ECX].TTypeInfo.Name[EDX+1].TTypeData.FloatType
  1064.  
  1065.         CALL    dword ptr @@jmpTab[EDX*4]
  1066.  
  1067. @@exit:
  1068.  
  1069. end;
  1070.  
  1071. procedure SetFloatProp(Instance: TObject; PropInfo: PPropInfo;
  1072.   Value: Extended); assembler;
  1073. asm
  1074.         { ->    EAX Pointer to instance         }
  1075.         {       EDX Pointer to property info    }
  1076.         {       Stack: Value                    }
  1077.  
  1078.         PUSH    EBX
  1079.         PUSH    ESI
  1080.  
  1081.         XOR     EBX,EBX
  1082.         MOV     ECX,[EDX].TPropInfo.PropType
  1083.         MOV     ECX,[ECX]
  1084.         MOV     BL,[ECX].TTypeInfo.Name.Byte[0]
  1085.         MOV     BL,[ECX].TTypeInfo.Name[EBX+1].TTypeData.FloatType
  1086.         SHL     EBX,2
  1087.         FLD     Value
  1088.         MOV     ECX,[EDX].TPropInfo.SetProc
  1089.         CMP     [EDX].TPropInfo.SetProc.Byte[3],$FE
  1090.         JA      @@isField
  1091.         SUB     ESP,dword ptr @@sizTab[EBX]
  1092.         MOV     ESI,ESP
  1093.         CALL    dword ptr @@storeProc[EBX]
  1094.  
  1095.         CMP     [EDX].TPropInfo.SetProc.Byte[3],$FE
  1096.         MOV     EDX,[EDX].TPropInfo.Index       { pass Index in DX      }
  1097.         JB      @@isStaticMethod
  1098.  
  1099.         MOVSX   ECX,CX
  1100.         ADD     ECX,[EAX]
  1101.         CALL    dword ptr [ECX]
  1102.         JMP     @@exit
  1103.  
  1104. @@isStaticMethod:
  1105.         CALL    ECX
  1106.         JMP     @@exit
  1107.  
  1108. @@sizTab:
  1109.         DD      4,8,12,8,8
  1110.  
  1111. @@storeProc:
  1112.         DD      @@single,@@double,@@extended,@@comp,@@curr
  1113.  
  1114. @@single:
  1115.         FSTP    [ESI].Single
  1116.         RET
  1117.  
  1118. @@double:
  1119.         FSTP    [ESI].Double
  1120.         RET
  1121.  
  1122. @@extended:
  1123.         FSTP    [ESI].Extended
  1124.         RET
  1125.  
  1126. @@comp:
  1127.         FISTP   [ESI].Comp
  1128.         RET
  1129.  
  1130. @@curr:
  1131.         FMUL    C10000
  1132.         FISTP   [ESI].Currency
  1133.         RET
  1134.  
  1135. @@isField:
  1136.         AND     ECX,$00FFFFFF
  1137.         LEA     ESI,[EAX+ECX]
  1138.         CALL    dword ptr @@storeProc[EBX]
  1139.  
  1140. @@exit:
  1141.         POP     ESI
  1142.         POP     EBX
  1143. end;
  1144.  
  1145. procedure AssignVariant(var Dest: Variant; const Source: Variant);
  1146. begin
  1147.   Dest := Source;
  1148. end;
  1149.  
  1150. function GetVariantProp(Instance: TObject; PropInfo: PPropInfo): Variant;
  1151. asm
  1152.         { ->    EAX Pointer to instance         }
  1153.         {       EDX Pointer to property info    }
  1154.         {       ECX Pointer to result variant   }
  1155.  
  1156.         PUSH    ESI
  1157.         PUSH    EDI
  1158.         MOV     EDI,EDX
  1159.  
  1160.         MOV     EDX,[EDI].TPropInfo.Index       { pass index in EDX }
  1161.         CMP     EDX,$80000000
  1162.         JNE     @@hasIndex
  1163.         MOV     EDX,ECX                         { pass value in EDX }
  1164. @@hasIndex:
  1165.         MOV     ESI,[EDI].TPropInfo.GetProc
  1166.         CMP     [EDI].TPropInfo.GetProc.Byte[3],$FE
  1167.         JA      @@isField
  1168.         JB      @@isStaticMethod
  1169.  
  1170. @@isVirtualMethod:
  1171.         MOVSX   ESI,SI                          { sign extend slot offset }
  1172.         ADD     ESI,[EAX]                       { vmt + slot offset }
  1173.         CALL    DWORD PTR [ESI]
  1174.         JMP     @@exit
  1175.  
  1176. @@isStaticMethod:
  1177.         CALL    ESI
  1178.         JMP     @@exit
  1179.  
  1180. @@isField:
  1181.     AND    ESI,$00FFFFFF
  1182.     LEA    EDX,[EAX+ESI]
  1183.     MOV    EAX,ECX
  1184.     CALL    AssignVariant
  1185.  
  1186. @@exit:
  1187.         POP     EDI
  1188.         POP     ESI
  1189. end;
  1190.  
  1191. procedure SetVariantProp(Instance: TObject; PropInfo: PPropInfo;
  1192.   const Value: Variant);
  1193. asm
  1194.         { ->    EAX Pointer to instance         }
  1195.         {       EDX Pointer to property info    }
  1196.         {       ECX Pointer to variant value    }
  1197.  
  1198.         PUSH    ESI
  1199.         PUSH    EDI
  1200.         MOV     ESI,EDX
  1201.  
  1202.         MOV     EDX,[ESI].TPropInfo.Index       { pass index in EDX }
  1203.         CMP     EDX,$80000000
  1204.         JNE     @@hasIndex
  1205.         MOV     EDX,ECX                         { pass value in EDX }
  1206. @@hasIndex:
  1207.         MOV     EDI,[ESI].TPropInfo.SetProc
  1208.         CMP     [ESI].TPropInfo.SetProc.Byte[3],$FE
  1209.         JA      @@isField
  1210.         JB      @@isStaticMethod
  1211.  
  1212. @@isVirtualMethod:
  1213.         MOVSX   EDI,DI
  1214.         ADD     EDI,[EAX]
  1215.         CALL    DWORD PTR [EDI]
  1216.         JMP     @@exit
  1217.  
  1218. @@isStaticMethod:
  1219.         CALL    EDI
  1220.         JMP     @@exit
  1221.  
  1222. @@isField:
  1223.     AND    EDI,$00FFFFFF
  1224.     ADD    EAX,EDI
  1225.     MOV    EDX,ECX
  1226.     CALL    AssignVariant
  1227.  
  1228. @@exit:
  1229.         POP     EDI
  1230.         POP     ESI
  1231. end;
  1232.  
  1233. function GetMethodProp(Instance: TObject; PropInfo: PPropInfo): TMethod;
  1234.   assembler;
  1235. asm
  1236.         { ->    EAX Pointer to instance         }
  1237.         {       EDX Pointer to property info    }
  1238.         {       ECX Pointer to result           }
  1239.  
  1240.         PUSH    EBX
  1241.         PUSH    ESI
  1242.         MOV     ESI,EDX
  1243.  
  1244.         MOV     EDX,[ESI].TPropInfo.Index       { pass Index in DX      }
  1245.         CMP     EDX,$80000000
  1246.         JNE     @@hasIndex
  1247.         MOV     EDX,ECX                         { pass value in EDX     }
  1248. @@hasIndex:
  1249.  
  1250.         MOV     EBX,[ESI].TPropInfo.GetProc
  1251.         CMP     [ESI].TPropInfo.GetProc.Byte[3],$FE
  1252.         JA      @@isField
  1253.         JB      @@isStaticMethod
  1254.  
  1255.         {       GetProc is a virtual method     }
  1256.         MOVSX   EBX,BX                          { sign extend slot number }
  1257.         ADD     EBX,[EAX]
  1258.         CALL    dword ptr [EBX]
  1259.         JMP     @@exit
  1260.  
  1261. @@isStaticMethod:
  1262.         CALL    EBX
  1263.         JMP     @@exit
  1264.  
  1265. @@isField:
  1266.         AND     EBX,$00FFFFFF
  1267.         ADD     EAX,EBX
  1268.         MOV     EDX,[EAX]
  1269.         MOV     EBX,[EAX+4]
  1270.         MOV     [ECX],EDX
  1271.         MOV     [ECX+4],EBX
  1272.  
  1273. @@exit:
  1274.         POP     ESI
  1275.         POP     EBX
  1276. end;
  1277.  
  1278. procedure SetMethodProp(Instance: TObject; PropInfo: PPropInfo;
  1279.   const Value: TMethod); assembler;
  1280. asm
  1281.         { ->    EAX Pointer to instance         }
  1282.         {       EDX Pointer to property info    }
  1283.         {       ECX Pointer to value            }
  1284.         PUSH    EBX
  1285.         MOV     EBX,[EDX].TPropInfo.SetProc
  1286.         CMP     [EDX].TPropInfo.SetProc.Byte[3],$FE
  1287.         JA      @@isField
  1288.         MOV     EDX,[EDX].TPropInfo.Index
  1289.         PUSH    dword ptr [ECX+4]
  1290.         PUSH    dword ptr [ECX]
  1291.         JB      @@isStaticMethod
  1292.  
  1293.         {       SetProc is a virtual method     }
  1294.         MOVSX   EBX,BX
  1295.         ADD     EBX,[EAX]
  1296.         CALL    dword ptr [EBX]
  1297.         JMP     @@exit
  1298.  
  1299. @@isStaticMethod:
  1300.         CALL    EBX
  1301.         JMP     @@exit
  1302.  
  1303. @@isField:
  1304.         AND     EBX,$00FFFFFF
  1305.         ADD     EAX,EBX
  1306.         MOV     EDX,[ECX]
  1307.         MOV     EBX,[ECX+4]
  1308.         MOV     [EAX],EDX
  1309.         MOV     [EAX+4],EBX
  1310.  
  1311. @@exit:
  1312.         POP     EBX
  1313. end;
  1314.  
  1315. end.
  1316.